VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "IO"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10
Private Const MOUSEEVENTF_WHEEL = &H800
Private Const WHEEL_UP = 120
Private Const WHEEL_DOWN = -120

Private Type POINTAPI
      X As Long
      Y As Long
End Type

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Boolean) As Integer
Private Declare Sub GetCursorPos Lib "user32" (lpPoint As POINTAPI)
Private Declare Function SetCursorPos& Lib "user32" (ByVal X As Long, ByVal Y As Long)
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Public Function GetMouseX() As Long
Dim RECT As POINTAPI
GetCursorPos RECT
GetMouseX = RECT.X
End Function

Public Function GetMouseY() As Long
Dim RECT As POINTAPI
GetCursorPos RECT
GetMouseY = RECT.Y
End Function

Public Sub SetMouseX(X As Long)
Dim Y As Long
Y = GetMouseY
SetCursorPos X, Y
End Sub

Public Sub SetMouseY(Y As Long)
Dim X As Long
X = GetMouseX
SetCursorPos X, Y
End Sub

Public Sub SetMousePos(X As Long, Y As Long)
SetCursorPos X, Y
End Sub

Public Sub MouseClick(Optional strButton As String = "left")
Select Case LCase(strButton)
Case "left"
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Case "middle"
    mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
Case "right"
    mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Select
End Sub

Public Sub MouseWheelUp()
mouse_event MOUSEEVENTF_WHEEL, 0, 0, WHEEL_UP, 0
End Sub

Public Sub MouseWheelDown()
mouse_event MOUSEEVENTF_WHEEL, 0, 0, WHEEL_DOWN, 0
End Sub

Public Sub ShowMouse()
ShowCursor True
End Sub

Public Sub HideMouse()
ShowCursor False
End Sub

Public Function GetKey(strKey As String) As Boolean
If Left(strKey, 1) = "{" Then
    If LCase(Left(strKey, 2)) = "{f" Then
        Dim keyCode As Long
        keyCode = 111
        If Len(strKey) = 4 Then
            keyCode = keyCode + Val(Mid(strKey, 3, 1))
        Else
            keyCode = keyCode + Val(Mid(strKey, 3, 2))
        End If
        GetKey = CBool(GetAsyncKeyState(keyCode))
    Else
        Select Case LCase(Mid(strKey, 2, Len(strKey) - 2))
        Case "backspace", "bs", "bksp"
            GetKey = CBool(GetAsyncKeyState(8))
        Case "break"
            GetKey = CBool(GetAsyncKeyState(19))
        Case "capslock"
            GetKey = CBool(GetAsyncKeyState(20))
        Case "delete", "del"
            GetKey = CBool(GetAsyncKeyState(46))
        Case "down"
            GetKey = CBool(GetAsyncKeyState(40))
        Case "end"
            GetKey = CBool(GetAsyncKeyState(35))
        Case "enter"
            GetKey = CBool(GetAsyncKeyState(13))
        Case "esc"
            GetKey = CBool(GetAsyncKeyState(27))
        Case "home"
            GetKey = CBool(GetAsyncKeyState(36))
        Case "insert", "ins"
            GetKey = CBool(GetAsyncKeyState(45))
        Case "left"
            GetKey = CBool(GetAsyncKeyState(37))
        Case "numlock"
            GetKey = CBool(GetAsyncKeyState(144))
        Case "pgdn"
            GetKey = CBool(GetAsyncKeyState(34))
        Case "pgup"
            GetKey = CBool(GetAsyncKeyState(33))
        Case "prtsc"
            GetKey = CBool(GetAsyncKeyState(44))
        Case "right"
            GetKey = CBool(GetAsyncKeyState(39))
        Case "scrolllock"
            GetKey = CBool(GetAsyncKeyState(145))
        Case "tab"
            GetKey = CBool(GetAsyncKeyState(9))
        Case "up"
            GetKey = CBool(GetAsyncKeyState(38))
        Case "windows"
            GetKey = CBool(GetAsyncKeyState(91)) Or CBool(GetAsyncKeyState(92))
        End Select
    End If
Else
    Select Case strKey
    Case "~"
        GetKey = CBool(GetAsyncKeyState(13))
    Case "+"
        GetKey = CBool(GetAsyncKeyState(16))
    Case "^"
        GetKey = CBool(GetAsyncKeyState(17))
    Case "%"
        GetKey = CBool(GetAsyncKeyState(18))
    Case Else
        GetKey = CBool(GetAsyncKeyState(Asc(strKey)))
    End Select
End If
End Function

Public Function GetKeys() As String
Dim i As Integer
Dim X As Integer

For i = 65 To 90
    X = GetAsyncKeyState(i)

    If X = -32767 Then
        GetKeys = Chr(i)
    End If
Next

For i = 8 To 222
    If i = 65 Then i = 91

    X = GetAsyncKeyState(i)

    If X = -32767 Then
        Select Case i
            Case 48: GetKeys = "0"
            Case 49: GetKeys = "1"
            Case 50: GetKeys = "2"
            Case 51: GetKeys = "3"
            Case 52: GetKeys = "4"
            Case 53: GetKeys = "5"
            Case 54: GetKeys = "6"
            Case 55: GetKeys = "7"
            Case 56: GetKeys = "8"
            Case 57: GetKeys = "9"
            Case 112: GetKeys = "{F1}"
            Case 113: GetKeys = "{F2}"
            Case 114: GetKeys = "{F3}"
            Case 115: GetKeys = "{F4}"
            Case 116: GetKeys = "{F5}"
            Case 117: GetKeys = "{F6}"
            Case 118: GetKeys = "{F7}"
            Case 119: GetKeys = "{F8}"
            Case 120: GetKeys = "{F9}"
            Case 121: GetKeys = "{F10}"
            Case 122: GetKeys = "{F11}"
            Case 123: GetKeys = "{F12}"
            Case 220: GetKeys = "\"
            Case 188: GetKeys = ","
            Case 189: GetKeys = "-"
            Case 190: GetKeys = "."
            Case 191: GetKeys = "/"
            Case 187: GetKeys = "="
            Case 186: GetKeys = ";"
            Case 222: GetKeys = "'"
            Case 219: GetKeys = "["
            Case 221: GetKeys = "]"
            Case 192: GetKeys = "`"
            Case 144: GetKeys = "{NUMLOCK}"
            Case 145: GetKeys = "{SCROLLLOCK}"
            Case 8: GetKeys = "{BACKSPACE}"
            Case 9: GetKeys = "{TAB}"
            Case 13: GetKeys = "{ENTER}"
            Case 16: GetKeys = "+"
            Case 17: GetKeys = "^"
            Case 18: GetKeys = "%"
            Case 19: GetKeys = "{BREAK}"
            Case 20: GetKeys = "{CAPSLOCK}"
            Case 27: GetKeys = "{ESC}"
            Case 32: GetKeys = " "
            Case 33: GetKeys = "{PGUP}"
            Case 34: GetKeys = "{PGDN}"
            Case 35: GetKeys = "{END}"
            Case 36: GetKeys = "{HOME}"
            Case 37: GetKeys = "{LEFT}"
            Case 38: GetKeys = "{UP}"
            Case 39: GetKeys = "{RIGHT}"
            Case 40: GetKeys = "{DOWN}"
            Case 44: GetKeys = "{PRTSC}"
            Case 45: GetKeys = "{INSERT}"
            Case 46: GetKeys = "{DELETE}"
            Case 91, 92: GetKeys = "{WINDOWS}"
        End Select
    End If
Next
End Function

Public Function GetKeyASCII(lngKey As Long) As Boolean
GetKeyASCII = CBool(GetAsyncKeyState(lngKey))
End Function

Public Function GetKeysASCII() As Integer
Dim i As Integer

For i = 8 To 222
    If CBool(GetAsyncKeyState(i)) Then GetKeysASCII = i
Next
End Function
